perm filename JUST.F4[MSS,LCS] blob sn#269264 filedate 1977-03-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  TO JUSTIFY SEVERAL MSS FILES AT ONCE. (UP TO 15.)(8*15=120)
C00018 ENDMK
C⊗;
C  TO JUSTIFY SEVERAL MSS FILES AT ONCE. (UP TO 15.)(8*15=120)
C TO CONVERT(ONE FILE AT A TIME)TO NEW FORMAT, USE 'CONVT' AS 'LAST NAME'.
C  LOAD WITH -- BIGGET.FAI ---
	COMMON/XRN/ RN(20000)/PTR/KWDS(2500) ,RSTFAC(120),STFF(120) 
	1 /RINP/RINP(8),K,SST(8),J,IB,RRT,A,Z,JJ,MX,H(8)
	1 /RJV/V(200) /RR4/R4,R5,P1,P2,IH,M
C  M=NUM OF STAVES. (BY 8S)
	COMMON JK,L,R8,R9,RDIS /NNP/NP(1500) /MMV/MV(1500) /KJY/KY,LY
C  INCREASE NP AND MV IF NEEDED -- PUT TRAP IN BIGGET!
	DATA EXT/'DMD'/,OUTX/'DMD'/
	DIMENSION JW(120),JR(120)

	TYPE 1
1	FORMAT(' FILE NAME 1?  '$)
CC	ACCEPT 200,N1
	CALL NAMEIN(N1,EXT)
200	FORMAT(A5)
	TYPE 300
300	FORMAT(' LAST NAME?  '$)
	ACCEPT 200,N2
	TYPE 3011
3011	FORMAT(' TYPE OUTPUT NAME 1 -- '$)
CC	ACCEPT 200,NMX
	CALL NAMEIN(NMX,OUTX)
	IF(N2.EQ.'CONVT')GO TO 111
	TYPE 100
100	FORMAT(' POS.1, POS.2 -  '$)
	ACCEPT 111,P1,P2
	IF(P2.EQ.0)P2=200
111	FORMAT(2F)
	IF(NMX.EQ.' ')NMX='AAAAA'

	JW(1)=1
	JR(1)=1
	M=1
	L=0
	JX=1
	IX=1
	NX=1
	NM=N1
40	CALL GETEXT(NM,EXT)
	CALL EXTIN(RINP,32)
	CALL EXTIN(KWDS(JX),J)
	CALL EXTIN(RN(IX),IB)
	J=J-2
	JJ=0
	DO 1111 K=NX,NX+7
	JJ=JJ+1
	RSTFAC(K)=RINP(JJ)
1111	STFF(K)=SST(JJ)

	IF(N2.EQ.'CONVT')GO TO 2
C ********* TYPE 999 AS POS1. FOR 'CONVERT', NAME2 WILL BE OUTPUT NM.
	RX=NX-1

	IF(RX.EQ.0)GO TO 410
	DO 41 K=JX,JX+J
	KWDS(K)=KWDS(K)+L
	KX=KWDS(K)+2
C  +2 IS FOR STAFF #
41	RN(KX)=RN(KX)+RX
410	IX=IB+IX-1
	L=IX-1
	JX=J+JX
	JW(M+1)=JX
C  POINTER TO START OF KWDS FOR EACH FILE
	JR(M+1)=IX  
	NX=NX+8
	IF(IX.LT.19500)GO TO 400
	RRT=IX
	TYPE 111,RRT
400	IF(NM.EQ.N2)GO TO 5
	NM=NM+2
	M=M+1
	GO TO 40

2	JJ=1
3001	L=KWDS(JJ)
	K=L+1
	A=RN(K)
	Z=RN(L)
	IF(A.LT.5)GO TO 3002
	IF(A.LE.10)GO TO 1177
	IF(A.NE.20)GO TO 3002
1177	IF(A.NE.6)GO TO 3003
	RN(K)=9
	GO TO 3002
3003	IF(A.NE.5)GO TO 3004
	RN(K)=10
	IF(Z.LT.4)GO TO 3010
	CALL EXCH(RN(L+5),RN(L+6))
	GO TO 3002
3004	IF(A.NE.7)GO TO 3005
	RN(K)=17
	GO TO 3010
3005	IF(A.EQ.8)RN(K)=5
	IF(A.EQ.9)RN(K)=6
	IF(A.NE.10)GO TO 3006
	RN(K)=8
	IF(Z.LT.4)GO TO 3010
	CALL EXCH(RN(L+4),RN(L+5))
	CALL EXCH(RN(L+6),RN(L+5))
 	GO TO 3002
3006	IF(A.EQ.20)RN(K)=7
	IF(A.NE.18)GO TO 3002
3010	FORMAT(' ITEM ',I3,', CODE ',F3.0)
	TYPE 3010,JJ,A
3002	A=RN(L+2)
	RN(L+2)=RN(L+3)
	RN(L+3)=A
	A=L+Z+3
	JJ=JJ+1
	IF(A.EQ.KWDS(JJ))GO TO 3001
	MX=1
CC	IF(N2.NE.' ')NM=N2
	GO TO 6

5	IB=JX-1
C  TOTAL IN RN ('I' IN MXX.F4)
	CALL JJUST

C  START OF WRITER
6	NM=NMX
	JX=1
	IX=1
	NX=1
	L=0
	ISCR=1
	Z=0

	MX=M
	M=1
7	CALL PUTEXT(NM,OUTX)
	JJ=0
	DO 7000 K=NX,NX+7
	JJ=JJ+1
	RINP(JJ)=RSTFAC(K)
7000	SST(JJ)=STFF(K)
	IF(N2.EQ.'CONVT')GO TO 3
	J=JW(M+1)-JW(M)
	IB=JR(M+1)-JR(M)+1
	P1=KWDS(JX+J)
	RX=NX-1
	IF(RX.EQ.0)GO TO 3
	DO 61 K=JX,JX+J-1
	KX=KWDS(K)
	KWDS(K)=KX-L
	KX=KX+2
61	RN(KX)=RN(KX)-RX
	KWDS(JX+J)=KWDS(JX+J)-L
3	L=IB+IX-2
	J=J+2
	CALL EXTOUT(RINP,32)
	CALL EXTOUT(KWDS(JX),J)
	CALL EXTOUT(RN(IX),IB)
	J=J-2
	KWDS(JX+J)=P1
	TYPE 60,NM

	IF(M.EQ.MX)CALL EXIT
	M=M+1
	JX=JW(M)
	IX=JR(M)

	NX=NX+8
CC	END FILE 21
	NM=NM+2
	GO TO 7
60	FORMAT(1XA5)
	END

	SUBROUTINE JJUST
	DATA RSP/.5/,RI/4.5/,RPX/.2/
	COMMON/XRN/ RN(20000)/PTR/KWDS(2500) ,RSTFAC(120),STFF(120) 
	1 /RINP/RINP(8),K,SST(8),J,IB,RRT,A,Z,JJ,MX,H(8)
	1 /RJV/R(2,100) /RR4/R4,R5,P1,P2,IH,M
C  M=NUM OF STAVES. (BY 8S)
	COMMON JK,L,R8,R9,RDIS /NNP/NP(1000) /MMV/MV(1000) /KJY/KY,LY
C  INCREASE NP AND MV IF NEEDED

	DIMENSION IR(2,100)
	EQUIVALENCE (R,IR)
	IX=KWDS(IB+1)-1
	PRCNT=1.
	RRT=P2
	R5=P2
	RZRO=P1
	R4=P1
	IF(RRT.EQ.0)RRT=200
	IF(RZRO.EQ.0)RZRO=.001
	JCNT=0
	RJSZ=RI
	CALL BIGGET
C  BIG GETPTS FAIL ROUTINE
	ML=1
	ROV=RRT
19	IF(JCNT.GT.9)GO TO 101
	RP=PRCNT
	RJSZ=RJSZ-RPX	
	JCNT=JCNT+1
C  TEMPORARY COUNTER
	TYPE 111,JCNT
111	FORMAT(I4)

	DO 11 KN=-3,M*8-4
	RSPC=0
	R8=KN
	N=0

	DO 2 K=1,KY
	L=NP(K)
	RL=RN(L)
	RA=RN(L+1)
	RB=RN(L+3)
	IF(RN(L+2).EQ.R8)GO TO 77
C  THIS STAFF?
	IF(RA.NE.4)GO TO 2
C  SKIPS HOMED NOTES (IN CHORDS)
CC77	IF(RA.EQ.1)GO TO 10
CC27	IF(RA.LE.4)GO TO 177
77	IF(RA.LT.3)GO TO 10
	IF(RA.EQ.4)GO TO 444
	IF(RA.EQ.3)GO TO 333
C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
	IF(RA.LT.17)GO TO 2
	GO TO 10
333	IF(RL.LT.3)GO TO 10
C  <3 MEANS NOTHING IN P5
	IF(RN(L+5).GT.3)GO TO 2
C  NOT A REAL CLEF IF >3
	GO TO 10
444	IF(RL.GT.2)GO TO 2
C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10	N=N+1
	R(1,N)=RB
	IR(2,N)=L
	IF(N.EQ.100)GO TO 28
C  ONLY TREATS 100 ITEMS AT A TIME.

2	CONTINUE

	IF(N.EQ.0)GO TO 11
CC28	KM=JFAC(L)
C  SEE FUNCTION JFAC.  RSTFAC PNTR.
28	DO 23 K=1,N
23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
C  SKIPS IF ONLY BAR LINES ON THIS STAFF
	GO TO 11
24	RSTJ2=RSTFAC(KN+4)*PRCNT
	CALL SORT2(R,N)

C  JUMP IF LAST IS A BAR LINE.
	K=0
	JLDGR=0
     	JX=0
22	K=K+1
122	L=IR(2,K)
	RA=RN(L+1)
	RB=0
	RX=RN(L+5)
C  RX=PARAM 5
	RX6=RN(L+6)
	RY=1
	RW=AMOD(RN(L+4),100.)
	IF(RA.GT.1)GO TO 4
	RZ=RN(L+7)
	IF(LDGR.NE.JLDGR)JLDGR=0
	LDGR=0
	JK=K
	DO 32 JJ=JK+1,N+1
	K=JJ
	RB=R(1,JJ)-R(1,JJ-1)
	IF(RB.GT.0.1)GO TO 320
C  PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
	R(1,JJ)=R(1,JJ-1)
	GO TO 32
320	IF(RB.GT.RSP)GO TO 35
32	CONTINUE
C  FOUND HOW MANY MEMBERS TO CHORD.
35	RB=0
	K=K-1
	RQ=0
	RD=0
125	IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
	DO 37 JJ=JK,K-1
	IF(RD.NE.0)GO TO 38
C FINDS ONLY HIGH OR! LOW LED. LINE.
	JIR=IR(2,JJ)
	RW=AMOD(RN(JIR+4),100.)
	IF(RW.GT.12)GO TO 277
	IF(RW.GE.2)GO TO 38
277	LDGR=-1
	IF(RW.GT.12)LDGR=1
	IF(JLDGR.EQ.LDGR)GO TO 36
	JLDGR=LDGR
C LDGR IS FOR LEDGER LINES.
	GO TO 38
36	RD=1.5
	RQ=RD
38	IF(RB.GT.2)GO TO 222
C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
	RZZ=RN(JIR+7)
	RE=RN(JIR+5)
	IF(RB.GE.2)GO TO 477

	RC=1.5
	IF(RZZ.LT.10)GO TO 378
	IF(RZZ.GE.20)RC=3.
C   10=DOT, 20=DOUBLE DOT
	GO TO 377
378	IF(RE.GE.20)GO TO 477
	IF(AMOD(RZZ,10.).EQ.0)GO TO 477
377	RB=RC+EXTEN(RZZ)
CC	IF(RZZ.GE.10)GO TO 377
CC	IF(RE.GE.20)GO TO 477
CC	IF(AMOD(RZZ,10.).EQ.0)GO TO 477
CC377	RB=1.5+EXTEN(RZZ)
C  SPACE FOR DOT OR TAIL(IF STEM UP)
477	IF(ABS(RN(JIR+6)).EQ.10)RB=RB+2
C  FOR CHORD TONES ON RIGHT OF STEM UP.
C  LOOKS THROUGH ALL NOTES OF A CHORD.
222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
C  JUMP IF NO ACCIS.
425	RD=2*RY+EXTEN(RE)
	IF(RQ.GT.RD)RD=RQ
	RQ=RD
C  FUNCT. EXTEN=AMOD(X,1.)*10.
37 	CONTINUE
	IF(RY.NE.1)RB=RB-.5*RJSZ
C  MINI NOTES NEED LESS SPACE
250	ACCX=0
	RC=0
	RW=R(1,JX+1)
	DO 132 JJ=JX+1,N  
	IF(RW.NE.R(1,JJ))GO TO 25
	KX=IR(2,JJ)
C  GET POINTER
	IF(RN(KX+1).NE.1)GO TO 25
C  ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
	RE=ABS(RN(KX+6))
	IF(RE.GE.10)RC=-2.6
	IF(RE.EQ.20)RC=-RC
CC 2/25/76	IF(ABS(RN(KX+6)).GE.20)RC=2.6
	RE=AMOD(RN(KX+5),10.0)
C  FIND AN ACCI
	IF(RE.EQ.0)GO TO 132
	IF(RE.GE.1)RC=RC+2
C  FOUND AN ACCI
	RC=AMOD(RE,1.0)*10.0+RC
C  ADD ANY EXTENSION TO THE LEFT
	IF(RC.GT.ACCX)ACCX=RC
	RC=0
	IF(ACCX.GT.RD)RD=ACCX
132	CONTINUE
25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
	GO TO 17
4	IF(RA.NE.2)GO TO 33
C  NEXT FOR DOTTED RESTS - IN P6
	IF(RN(L).GE.4)RB=RN(L+6)*1.5
C  NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
	GO TO 250
33	IF(RA.NE.3)GO TO 29
	RB=3
	IF(RN(L+4).GT.80)RB=1.5
C  CHECK ON SIZE NEEDED FOR CLEFS.  >80 = MINICLEF
29	IF(RA.NE.4)GO TO 26
	RB=-RJSZ/2
	RD=.9
	GO TO 25
26	IF(RA.NE.18)GO TO 30
	RB=-1
	RD=1
	IF(RX6.LE.9.AND.RX.LE.9)GO TO 25
CC	IF(RX.GT.9)GO TO 31
C  CHECKS FOR 2-DIGIT METERS
	RD=2
	RB=0
CN	IF(RX6.GT.9)GO TO 31
CN	IF(RX.GT.9)GO TO 31
C  CHECKS FOR 2-DIGIT METERS
CN	RB=-1
CN	RD=1
CN	GO TO 25
CN31	RB=2
CN	RD=3
	GO TO 25
30	IF(RA.NE.17)GO TO 17
	RX=ABS(RX)
	IF(RX.GE.100)RX=RX-100
C  +100 FOR NATURALS AS KEYSIG.
	RB=2*(RX-1)-2
CC	RB=2*(ABS(RX)-1)-2
	RD=2
	GO TO 25
C  SPACES FOR CORRECT NUM OF ACCIS.
17	RC=(RB+RJSZ)*RSTJ2
C  RJSZ=DEFAULT SIZE
CC	JX=JX+1
	JX=K
	R(2,JX)=RC
CC	R(1,JX)=R(1,K)
3	IF(K.LT.N)GO TO 22
	RA=R(1,1)
	RB=R(2,1)

	DO 13 KX=2,JX
	RE=R(1,KX)
C  POS. BEFORE SHIFTING
	IF(ABS(RE-RA).GT..5)GO TO 14
	IF(R(2,KX).GT.RB)GO TO 16
C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
	GO TO 13
CC	IF(RZZ.LE.RB)GO TO 13
C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
CC	RB=RZZ-RB
14	RD=RA+RB-RE
	IF(RD.LE.0)GO TO 16
C  THERE'S ENOUGH ROOM
CC	RD=RA+RB-RE+RD
	ROV=ROV+RD

140	R4=RE+RSPC-.001
	R5=1000
C  MAYBE MORE? ↑↑↑↑↑
	R8=RD
	R9=0
C  GO EXPAND IT
	IF(R(2,KX).EQ.0)GO TO 15
	CALL MOVIT
	R5=R4
	R4=RA+.001+RSPC
	R8=R4
	R9=R5+RD-.001
C  FOR ITEMS ON OTHER LINES.
	CALL MOVIT
15	RSPC=RSPC+RD
C  RSPC SAVES TOTAL SPACE ADDED
16	RB=R(2,KX)
13	RA=RE
11	CONTINUE
110	IF(ROV.LE.RRT+.01)RETURN  
	IF(RJSZ.GT.4)RJSZ=4
	PRCNT=(ROV-RZRO)/(RRT-RZRO)
	IF(PRCNT.NE.RP)GO TO 19
101	R4=RZRO
	R5=ROV
	R8=RZRO
	R9=RRT-.001
C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
	CALL MOVIT
	END
	
C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
	SUBROUTINE MVBEAM(I)
C  L AND JK ARE FOR MOVES TO DIFF. STAFF.
	COMMON JK,L,R8,R9,RDIS /XRN/RN(20000)
	Y=RN(JK+I)
	Z=ABS(Y)
	IF(Z.LT.100.)GO TO 1
C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
	Y=AMOD(Y,100.)
	X=Y+R8
	Z=Z-ABS(Y)+ABS(X)
C  PUTS ALL INTO POSITIVE
	IF(X)Z=-Z
	GO TO 2
1	Z=Y+R8
2	RN(L+I)=Z
	END
	SUBROUTINE NAMEIN(NAME,EXT)
	COMMON /ALF/I(10)
	ACCEPT 1,I
	DO 2 K=2,6
	IF(I(K).EQ.' ')GO TO 3
2	IF(I(K).EQ.'.')GO TO 4
3	REREAD 99,NAME
	RETURN
4	GO TO(1,5,6,7,8,9),K
1	FORMAT(10A1)
55	FORMAT(2A1,A3)
66	FORMAT(A2,A1,A3)
77	FORMAT(A3,A1,A3)
88	FORMAT(A4,A1,A3)
99	FORMAT(A5,A1,A3)
5	REREAD 55,NAME,K,EXT
	RETURN
6	REREAD 66,NAME,K,EXT
	RETURN
7	REREAD 77,NAME,K,EXT
	RETURN
8	REREAD 88,NAME,K,EXT
	RETURN
9	REREAD 99,NAME,K,EXT
	END